home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Controls / Visual Basic Controls.iso / vbcontrol / sgwnd10 / combobox.cls < prev    next >
Encoding:
Visual Basic class definition  |  1998-07-28  |  20.1 KB  |  629 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "ComboBoxEx"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = False
  10. Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes"
  11. Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
  12. Attribute VB_Ext_KEY = "Member0" ,"ComboItems"
  13. Option Explicit
  14. '----ComboEx Declare---------------------------------
  15. Private mlParentHwnd As Long           'UserControl hWnd
  16. Private mhImageList As Long            'image list handle
  17. Public mComboItems As ComboItems       'collection of combo items
  18.  
  19. Private miNewIndex As Integer          'last added item
  20.  
  21. Private Const WM_CTLCOLOREDIT = &H133
  22. Private Const WM_SETFONT = &H30
  23.  
  24. Private Const CBEX_DEF_HEIGHT = 150
  25.  
  26. Private NewComboFont As Long
  27. Private cmbFontBold As Boolean
  28. Private cmbFontItalic As Boolean
  29. Private cmbFontName As String
  30. Private cmbFontHeight As Integer
  31. Private cmbCustomize As Boolean
  32. Private cmbFontUnderlined As Boolean
  33.  
  34. Private Const SYSTEM_FONT& = 13
  35. Private LF As LOGFONT
  36. Public Enum cbIconState
  37.   cbNormal = 0
  38.   cbDisabled = 1
  39. End Enum
  40.  
  41. Private Type FONTSTRUC
  42.     lStructSize As Long
  43.     hwnd As Long
  44.     hdc As Long
  45.     lpLogFont As Long
  46.     iPointSize As Long
  47.     flags As Long
  48.     rgbColors As Long
  49.     lCustData As Long
  50.     lpfnHook As Long
  51.     lpTemplateName As String
  52.     hInstance As Long
  53.     lpszStyle As String
  54.     nFontType As Integer
  55.     MISSING_ALIGNMENT As Integer
  56.     nSizeMin As Long
  57.     nSizeMax As Long
  58. End Type
  59.  
  60. Private Type LOGFONT
  61.     lfHeight As Long
  62.     lfWidth As Long
  63.     lfEscapement As Long
  64.     lfOrientation As Long
  65.     lfWeight As Long
  66.     lfItalic As Byte
  67.     lfUnderline As Byte
  68.     lfStrikeOut As Byte
  69.     lfCharSet As Byte
  70.     lfOutPrecision As Byte
  71.     lfClipPrecision As Byte
  72.     lfQuality As Byte
  73.     lfPitchAndFamily As Byte
  74.     lffacename As String * 32
  75.    'lfFaceName(LF_FACESIZE) As Byte
  76. End Type
  77.  
  78. Private Const GMEM_MOVEABLE = &H2
  79. Private Const GMEM_ZEROINIT = &H40
  80. Private Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT)
  81. Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
  82. Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
  83. Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
  84. Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
  85. Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
  86. Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
  87. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
  88. Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
  89. Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
  90. Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
  91. Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
  92. Private Declare Function SendMessageByString& Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String)
  93. Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
  94. Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
  95. Private Declare Function SendMessageByLong Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
  96. Private Declare Function ExtractIconEx Lib "shell32.dll" Alias "ExtractIconExA" (ByVal lpszFile As String, ByVal nIconIndex As Long, phiconLarge As Long, phiconSmall As Long, ByVal nIcons As Long) As Long
  97. Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
  98. Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
  99. Private Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As Long
  100. Private Declare Function CreateWindowEX Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
  101. Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
  102. Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
  103. Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
  104. Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
  105. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  106. Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
  107. Private Declare Function GetTextFace Lib "gdi32" Alias "GetTextFaceA" (ByVal hdc As Long, ByVal nCount As Long, ByVal lpFacename As String) As Long
  108. Private Declare Function GetTextMetrics Lib "gdi32" Alias "GetTextMetricsA" (ByVal hdc As Long, lpMetrics As TEXTMETRIC) As Long
  109. Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
  110. Private Declare Function UpdateWindow Lib "user32" (ByVal hwnd As Long) As Long
  111. Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
  112. Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
  113. Private Declare Function InitCommonControlsEx Lib "comctl32.dll" (iccex As tagInitCommonControlsEx) As Boolean
  114. Private Declare Function SendStringMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
  115. Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
  116.  
  117.  
  118. Private Type TEXTMETRIC
  119.         tmHeight As Long
  120.         tmAscent As Long
  121.         tmDescent As Long
  122.         tmInternalLeading As Long
  123.         tmExternalLeading As Long
  124.         tmAveCharWidth As Long
  125.         tmMaxCharWidth As Long
  126.         tmWeight As Long
  127.         tmOverhang As Long
  128.         tmDigitizedAspectX As Long
  129.         tmDigitizedAspectY As Long
  130.         tmFirstChar As Byte
  131.         tmLastChar As Byte
  132.         tmDefaultChar As Byte
  133.         tmBreakChar As Byte
  134.         tmItalic As Byte
  135.         tmUnderlined As Byte
  136.         tmStruckOut As Byte
  137.         tmPitchAndFamily As Byte
  138.         tmCharSet As Byte
  139. End Type
  140.  
  141.  
  142. Private Type RECT
  143.       Left As Long
  144.       Top As Long
  145.       Right As Long
  146.       Bottom As Long
  147. End Type
  148.  
  149. Private Type tagInitCommonControlsEx
  150.     lngSize As Long
  151.     lngICC As Long
  152. End Type
  153.  
  154. Private Const CF_BITMAP = 2
  155. Private Const SWP_NOACTIVATE = &H10
  156.  
  157. Private Const CB_SETCURSEL = &H14E
  158. Private Const CB_GETCOUNT = &H146
  159. Private Const CB_GETCURSEL = &H147
  160. Private Const CB_GETEDITSEL = &H140
  161. Private Const CB_GETLBTEXT = &H148
  162. Private Const CB_GETLBTEXTLEN = &H149
  163. Private Const CB_SELECTSTRING = &H14D
  164. Private Const CB_FINDSTRING = &H14C
  165. Private Const CB_FINDSTRINGEXACT = &H158
  166. Private Const CB_SETDROPPEDWIDTH = &H160
  167. Private Const CB_SETITEMHEIGHT = &H153
  168. Private Const CB_RESETCONTENT = &H14B
  169.  
  170.  
  171. Private cbItems As COMBOBOXEXITEMW
  172. 'window stiles
  173. Private Const WS_VISIBLE = &H10000000
  174. Private Const WS_CHILD = &H40000000
  175. Private Const WS_TABSTOP = &H10000
  176. Private Const WS_GROUP = &H20000
  177. Private Const WS_MAXIMIZE = &H1000000
  178. Private Const WS_OVERLAPPED = &H0&
  179.  
  180. Private Const WM_USER = &H400
  181. Private Const GWL_HWNDPARENT = (-8)
  182. Private Const GWL_STYLE = (-16)
  183.  
  184. Private ComboExhWnd As Long
  185.  
  186. Const HWND_TOPMOST = -1
  187. Const SW_HIDE = 0
  188. Const SW_SHOWNORMAL = 1
  189.  
  190. Const SWP_NOSIZE = &H1
  191. Const SWP_NOMOVE = &H2
  192. Const SWP_NOREDRAW = &H8
  193. Const SWP_SHOWWINDOW = &H40
  194.  
  195. Private Const ICC_USEREX_CLASSES = &H200
  196.  
  197. Private Const WC_COMBOBOXEXW = "ComboBoxEx32"
  198. Private Const WC_COMBOBOXEXA = "ComboBoxEx32"
  199.  
  200. #If UNICODE Then
  201. Private Const WC_COMBOBOXEX = WC_COMBOBOXEXW
  202. #Else
  203. Private Const WC_COMBOBOXEX = WC_COMBOBOXEXA
  204. #End If
  205.  
  206. Private Const CBS_DROPDOWN = &H2&
  207. Private Const CBS_DROPDOWNLIST = &H3&
  208. Private Const CBS_HASSTRINGS = &H200&
  209. Private Const CBS_DISABLENOSCROLL = &H800&
  210. Private Const CBS_NOINTEGRALHEIGHT = &H400&
  211. Private Const CBS_OWNERDRAWFIXED = &H10&
  212. Private Const CBS_OWNERDRAWVARIABLE = &H20&
  213. Private Const CBS_SIMPLE = &H1&
  214. Private Const CBS_SORT = &H100&
  215. Private Const CB_SETEDITSEL = &H142
  216.  
  217. Private Const CBEIF_TEXT = &H1
  218. Private Const CBEIF_IMAGE = &H2
  219. Private Const CBEIF_SELECTEDIMAGE = &H4
  220. Private Const CBEIF_OVERLAY = &H8
  221. Private Const CBEIF_INDENT = &H10
  222. Private Const CBEIF_LPARAM = &H20
  223. Private Const CBEIF_DI_SETITEM = &H10000000
  224. Private Const H_MAX As Long = &HFFFF + 1
  225. Private Const CBEN_FIRST = (H_MAX - 800&)
  226. Private Const CBEN_LAST = (H_MAX - 830&)
  227. Private Const CBEN_GETDISPINFO = (CBEN_FIRST - 0)
  228. Private Const CBEN_INSERTITEM = (CBEN_FIRST - 1)
  229. Private Const CBEN_DELETEITEM = (CBEN_FIRST - 2)
  230. Private Const CBEN_BEGINEDIT = (CBEN_FIRST - 4)
  231. Private Const CBEN_ENDEDITA = (CBEN_FIRST - 5)
  232. Private Const CBEN_ENDEDITW = (CBEN_FIRST - 6)
  233. Private Const CBN_EDITCHANGE = 5
  234. Private Const CBN_EDITUPDATE = 6
  235. Private Const CBN_SELCHANGE = 1
  236. Private Const CB_DELETESTRING = &H144
  237. Private Const CBEM_INSERTITEMA = (WM_USER + 1)
  238. Private Const CBEM_SETIMAGELIST = (WM_USER + 2)
  239. Private Const CBEM_GETIMAGELIST = (WM_USER + 3)
  240. Private Const CBEM_GETITEMA = (WM_USER + 4)
  241. Private Const CBEM_SETITEMA = (WM_USER + 5)
  242. Private Const CBEM_DELETEITEM = CB_DELETESTRING
  243. Private Const CBEM_GETCOMBOCONTROL = (WM_USER + 6)
  244. Private Const CBEM_GETEDITCONTROL = (WM_USER + 7)
  245. Private Const CBEM_SETEXSTYLE = (WM_USER + 8)
  246. Private Const CBEM_GETEXSTYLE = (WM_USER + 9)
  247. Private Const CBEM_HASEDITCHANGED = (WM_USER + 10)
  248. Private Const CBEM_INSERTITEMW = (WM_USER + 11)
  249. Private Const CBEM_SETITEMW = (WM_USER + 12)
  250. Private Const CBEM_GETITEMW = (WM_USER + 13)
  251. Private Const CBN_SELENDOK = 9
  252.  
  253.  
  254. Private Type COMBOBOXEXITEMW
  255.     mask As Long
  256.     iItem As Long
  257.     pszText As String
  258.     cchTextMax  As Long
  259.     iImage As Long
  260.     iSelectedImage As Long
  261.     iOverlay As Long
  262.     iIndent As Long
  263.     lParam As Long
  264. End Type
  265.  
  266.  
  267. #If UNICODE Then
  268.    Private Const CBEM_INSERTITEM = CBEM_INSERTITEMW
  269.    Private Const CBEM_SETITEM = CBEM_SETITEMW
  270.    Private Const CBEM_GETITEM = CBEM_GETITEMW
  271. #Else
  272.    Private Const CBEM_INSERTITEM = CBEM_INSERTITEMA
  273.    Private Const CBEM_SETITEM = CBEM_SETITEMA
  274.    Private Const CBEM_GETITEM = CBEM_GETITEMA
  275. #End If
  276.  
  277. Private Const CBES_EX_NOEDITIMAGE = &H1
  278. Private Const CBES_EX_NOEDITIMAGEINDENT = &H2
  279. Private Const CBES_EX_PATHWORDBREAKPROC = &H4
  280.  
  281. Private Const TRANSPARENT = 1
  282.  
  283.  
  284. Public Property Get ComboItems() As ComboItems
  285.     Set ComboItems = mComboItems
  286. End Property
  287.  
  288.  
  289. Public Property Set ComboItems(vData As ComboItems)
  290.     Set mComboItems = vData
  291. End Property
  292.  
  293.  
  294.  
  295. Public Property Let ImageList(ByVal vData As Long)
  296.     mhImageList = vData
  297.     
  298.    'Set the Imagelist for the ComboBox
  299.    Call SendMessage(ComboExhWnd, CBEM_SETIMAGELIST, 0, ByVal mhImageList)
  300.  
  301. End Property
  302.  
  303.  
  304. Public Property Get ImageList() As Long
  305.     ImageList = mhImageList
  306. End Property
  307.  
  308.  
  309.  
  310.  
  311. Public Property Let ParentHwnd(ByVal vData As Long)
  312.     mlParentHwnd = vData
  313. End Property
  314.  
  315.  
  316. Public Function GetComboHwnd() As Long
  317.    GetComboHwnd = ComboExhWnd
  318. End Function
  319.  
  320. Public Property Get ParentHwnd() As Long
  321.     ParentHwnd = mlParentHwnd
  322. End Property
  323.  
  324.  
  325.  
  326.  
  327.  
  328. Public Sub Clear()
  329.    Dim i As Integer, Total%
  330.    
  331.    Total = ListCount
  332.    
  333.    For i = 0 To Total - 2
  334.        Call SendMessage(ComboExhWnd, CBEM_DELETEITEM, 0, 0)
  335.    Next
  336.    
  337.    cbItems.mask = 0&
  338.    cbItems.pszText = ""
  339.    cbItems.cchTextMax = 0
  340.    cbItems.iIndent = 0
  341.    cbItems.iImage = -1
  342.    cbItems.iSelectedImage = -1
  343.    cbItems.iItem = -1
  344.    cbItems.iOverlay = -1
  345.    
  346.    For i = 1 To mComboItems.Count
  347.        mComboItems.Remove 1
  348.    Next
  349.     
  350.    Call SendMessage(ComboExhWnd, CBEM_INSERTITEM, -1, cbItems)
  351.    Call SendMessage(ComboExhWnd, CBEM_DELETEITEM, 0, 0)
  352.    
  353.    SetIndex 0
  354. End Sub
  355.  
  356. Public Sub RefreshItem(Index As Integer, ByVal NewText As String, _
  357.    ByVal ImgIndex As Integer, _
  358.    ByVal Indent As Integer)
  359.  
  360.    cbItems.mask = CBEIF_TEXT Or CBEIF_INDENT Or CBEIF_IMAGE Or _
  361.       CBEIF_LPARAM Or CBEIF_SELECTEDIMAGE Or CBEIF_OVERLAY
  362.    cbItems.pszText = NewText
  363.    cbItems.cchTextMax = Len(NewText)
  364.    cbItems.iIndent = Indent
  365.    cbItems.iImage = ImgIndex
  366.    cbItems.iSelectedImage = ImgIndex
  367.    cbItems.iItem = Index
  368.    cbItems.iOverlay = ImgIndex
  369.  
  370.    Call SendMessage(ComboExhWnd, CBEM_SETITEM, Index, cbItems)
  371. End Sub
  372.  
  373. Public Sub RemoveItem(ByVal Item As Integer)
  374.    Call SendMessage(ComboExhWnd, CBEM_DELETEITEM, Item, 0)
  375.    
  376.    mComboItems.Remove Item + 1
  377.    SetIndex 0
  378. End Sub
  379. Public Sub Destroy()
  380.    On Error Resume Next
  381.    
  382.    Call DestroyWindow(ComboExhWnd)
  383. End Sub
  384.  
  385. Public Function GetDropDownHwnd() As Long
  386.    GetDropDownHwnd = SendMessage(ComboExhWnd, CBEM_GETCOMBOCONTROL, 0, 0)
  387. End Function
  388.  
  389. Public Function GetEditString() As String
  390.    Dim EditHwnd As Long
  391.    Dim ComboString As String * 255, lResult As Long
  392.    
  393.    'Gets the Text in the Edit portion of the ComboBox
  394.    EditHwnd = SendMessage(ComboExhWnd, CBEM_GETEDITCONTROL, 0, 0)
  395.    lResult = GetWindowText(EditHwnd, ComboString, Len(ComboString))
  396.    GetEditString = Left(ComboString, lResult)
  397. End Function
  398.  
  399. Public Function GetEdithWnd() As Long
  400.    GetEdithWnd = SendMessage(ComboExhWnd, CBEM_GETEDITCONTROL, 0, 0)
  401. End Function
  402. Public Function ListCount() As Integer
  403.    ListCount = SendMessage(GetComboHwnd, CB_GETCOUNT, 0, 0)
  404. End Function
  405.  
  406. Public Sub SetEditString(EditString As String)
  407.    Dim EditHwnd As Long
  408.    Dim lResult As Long
  409.    'Sets the Text in the Edit portion of the ComboBox
  410.    'Only if it's editable
  411.    EditHwnd = SendMessage(ComboExhWnd, CBEM_GETEDITCONTROL, 0, 0)
  412.    lResult = SetWindowText(EditHwnd, ByVal EditString)
  413.    Call UpdateWindow(EditHwnd)
  414.  
  415. End Sub
  416. Public Function ResizeCombo(NewWidth As Integer) As Long
  417.    Dim rc As RECT, FormRect As RECT
  418.     
  419.    Call GetWindowRect(ComboExhWnd, rc)
  420.     
  421.    Call MoveWindow(ComboExhWnd, 0&, 0&, _
  422.       CLng(NewWidth / Screen.TwipsPerPixelX), CLng(rc.Bottom - rc.Top), True)
  423.       
  424.    ResizeCombo = CLng(rc.Bottom - rc.Top) * Screen.TwipsPerPixelY
  425. End Function
  426.  
  427.  
  428. Public Sub SetDropWidth(NewWidth As Integer)
  429. Call SendMessage(GetDropDownHwnd, CB_SETDROPPEDWIDTH, NewWidth * Screen.TwipsPerPixelX, 0&)
  430.  
  431. End Sub
  432.  
  433. Public Sub SetIndex(Index As Integer)
  434.    Dim CurSel As Long
  435.     
  436.    CurSel = SendMessage(ComboExhWnd, CB_SETCURSEL, Index, 0)
  437. End Sub
  438. Public Sub SetItemHeight(ItemHeight As Integer)
  439.  
  440. 'Set the New Item Height of drop down
  441. Call SendMessageByLong(GetDropDownHwnd, CB_SETITEMHEIGHT, 0, ByVal (ItemHeight And &HFFFF))
  442.  
  443. 'Update the Window
  444. Call UpdateWindow(GetDropDownHwnd)
  445.  
  446. End Sub
  447.  
  448. Private Sub Class_Initialize()
  449. Dim iccex As tagInitCommonControlsEx
  450.     With iccex
  451.         .lngSize = LenB(iccex)
  452.         .lngICC = ICC_USEREX_CLASSES
  453.     End With
  454.     
  455.     Call InitCommonControlsEx(iccex)
  456.  
  457.    ComboExhWnd = 0
  458.    
  459.    Set mComboItems = New ComboItems
  460. End Sub
  461.  
  462. Public Function Create(iCmbStyle As Integer) As Boolean
  463.    Dim lWidth&, lHeight&, rc As RECT
  464.    Dim lStyle&
  465.    
  466.    Call GetWindowRect(mlParentHwnd, rc)
  467.    
  468.    lWidth = rc.Right - rc.Left
  469.    lHeight = CBEX_DEF_HEIGHT
  470.    
  471.    Select Case iCmbStyle
  472.       Case 1   'simple
  473.          lStyle = WS_CHILD Or WS_VISIBLE Or ws_BORDER Or CBS_SIMPLE Or WS_TABSTOP
  474.       Case 2  'dropdown list
  475.          lStyle = WS_CHILD Or WS_VISIBLE Or ws_BORDER Or CBS_DROPDOWNLIST Or WS_TABSTOP
  476.       Case Else 'dropdown combo
  477.          lStyle = WS_CHILD Or WS_VISIBLE Or ws_BORDER Or CBS_DROPDOWN Or WS_TABSTOP
  478.    End Select
  479.    
  480.     ComboExhWnd = CreateWindowEX(0, WC_COMBOBOXEX, "", _
  481.             lStyle, _
  482.             0, 0, lWidth, lHeight, _
  483.             mlParentHwnd, 0&, App.hInstance, 0&)
  484.    
  485.    'Set the parent to receive the messages
  486.    Call SetParent(ComboExhWnd, mlParentHwnd)
  487.    
  488.    Call MoveWindow(ComboExhWnd, 0, 0, CLng(lWidth), CLng(lHeight), True)
  489.    
  490.    If cmbCustomize = True Then SetComboFont
  491.    
  492.    Call ShowWindow(ComboExhWnd, SW_SHOWNORMAL)
  493.    
  494. End Function
  495.  
  496.  
  497. Public Sub Additems(ByVal CmbText As String, _
  498.    ByVal ImgIndex As Integer, _
  499.    ByVal Indent As Integer, ByVal Index As Integer)
  500.    Dim cmbItem As ComboItem
  501.    Dim lNewIndex&
  502.    
  503.    ImgIndex = ImgIndex - 1
  504.    
  505.    cbItems.mask = CBEIF_TEXT Or CBEIF_INDENT Or CBEIF_IMAGE Or _
  506.       CBEIF_LPARAM Or CBEIF_SELECTEDIMAGE Or CBEIF_OVERLAY
  507.    cbItems.pszText = CmbText
  508.    cbItems.cchTextMax = Len(CmbText)
  509.    cbItems.iIndent = Indent
  510.    cbItems.iImage = ImgIndex
  511.    cbItems.iSelectedImage = ImgIndex
  512.    cbItems.iItem = Index
  513.    cbItems.iOverlay = ImgIndex
  514.    
  515.    lNewIndex = SendMessage(ComboExhWnd, CBEM_INSERTITEM, 0, cbItems)
  516.    
  517.    If Index = -1 Then
  518.       Set cmbItem = mComboItems.Add("C" & Trim$(Index))
  519.       cmbItem.Image = ImgIndex
  520.       cmbItem.Indent = Indent
  521.    Else
  522.       Set cmbItem = mComboItems.Item(Index)
  523.    End If
  524.    
  525.    NewIndex = CInt(lNewIndex)
  526.    
  527.    cmbItem.Text = CmbText
  528.  
  529. End Sub
  530.  
  531. Public Function GetSelectedItem() As Integer
  532.    On Error Resume Next
  533.    
  534.    GetSelectedItem = SendMessage(ComboExhWnd, CB_GETCURSEL, 0, 0)
  535.    
  536. End Function
  537.  
  538. Private Sub Class_Terminate()
  539.   Set mComboItems = Nothing
  540.    On Error Resume Next
  541.    
  542.    Set mComboItems = Nothing
  543.  
  544.    If ComboExhWnd <> 0 Then
  545.       Call DestroyWindow(ComboExhWnd)
  546.    End If
  547.    
  548.    Dim dl As Long
  549.    
  550.    If NewComboFont <> 0 Then
  551.       dl = DeleteObject(NewComboFont)
  552.    End If
  553. End Sub
  554. Public Sub SetComboFont()
  555.  
  556.     Dim cbDC As Long
  557.  
  558.     cbDC = GetDC(GetDropDownHwnd)
  559.   
  560.     Dim CurrentComboFont As Long
  561.     
  562.     Dim dl As Long
  563.  
  564.     Dim mFlags As Long
  565.      
  566.     CurrentComboFont = SelectObject(cbDC, GetStockObject(SYSTEM_FONT))
  567.      
  568.     dl = SetBkMode(cbDC, TRANSPARENT)
  569.     
  570.     LF.lffacename = cmbFontName & Chr$(0)
  571.     LF.lfHeight = cmbFontHeight
  572.     LF.lfUnderline = cmbFontUnderlined
  573.     LF.lfItalic = cmbFontItalic
  574.     
  575.     If cmbFontBold = True Then
  576.     LF.lfWeight = 600
  577.     Else
  578.     LF.lfWeight = 300
  579.     End If
  580.   
  581.     NewComboFont = CreateFontIndirect(LF)
  582.     dl = SelectObject(cbDC, NewComboFont)
  583.       
  584.     'Set the New Font to drop down
  585.     Call SendMessage(GetDropDownHwnd, WM_SETFONT, NewComboFont, 1)
  586.     
  587.     Dim EditHwnd As Long
  588.     EditHwnd = SendMessage(ComboExhWnd, CBEM_GETEDITCONTROL, 0, 0)
  589.     
  590.     'Set the New Font to the Edit window
  591.     Call SendMessage(EditHwnd, WM_SETFONT, NewComboFont, 1)
  592.        
  593.     NewComboFont = SelectObject(cbDC, CurrentComboFont)
  594.     'Restore original font
  595.     dl = SelectObject(cbDC, CurrentComboFont)
  596.     
  597.     'NewComboFont is deleted in terminate Event
  598.      
  599. End Sub
  600. Public Property Let FontBold(ByVal vNewValue As Boolean)
  601.    cmbFontBold = vNewValue
  602.    cmbCustomize = True
  603. End Property
  604. Public Property Let FontItalic(ByVal vNewValue As Boolean)
  605. cmbFontItalic = vNewValue
  606. cmbCustomize = True
  607. End Property
  608. Public Property Let FontName(ByVal vNewValue As String)
  609. cmbFontName = vNewValue
  610. cmbCustomize = True
  611. End Property
  612. Public Property Let FontHeight(ByVal vNewValue As Integer)
  613. cmbFontHeight = vNewValue
  614. cmbCustomize = True
  615. End Property
  616. Public Property Let FontUnderlined(ByVal vNewValue As Boolean)
  617. cmbFontUnderlined = vNewValue
  618. cmbCustomize = True
  619. End Property
  620.  
  621.  
  622. Public Property Get NewIndex() As Integer
  623.    NewIndex = miNewIndex
  624. End Property
  625.  
  626. Public Property Let NewIndex(ByVal vNewValue As Integer)
  627.    miNewIndex = vNewValue
  628. End Property
  629.